(FILECREATED " 6-APR-74 07:17:19" EXAMPLE)


  (LISPXPRINT (QUOTE EXAMPLEVARS)
              T)
  (RPAQQ EXAMPLEVARS
         ((FNS EXAMPLE SELECT SELECTL SELECTLL EDGES EXAMPLELLABELNODES 
               EXAMPLELABELFV EXAMPLELABELEDGES 1ATRAND SPLIT REXAMPLE)
          (VARS (EXAMPLEFIXED))
          (USERMACROS DE)))
(DEFINEQ

(EXAMPLE
  [LAMBDA (X)
    (COND
      ((type? STRUCTURE X)
        X)
      [(STRUCLIST? X)
        (EXAMPLE (1ATRAND (CDDR X]
      ((NOFORMIN X)
        X)
      [(NOT EXAMPLEFIXED)
        (UNDONLSETQ
          (PROG (Y (EXAMPLEFIXED T)
                   (GENSYMLST (QUOTE ($$1 $$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10 
                                          $$11 $$12 $$13 $$14 $$15)))
                   TEM)
                (SETQ TEM
                  (OR (GETP (CAR (fetch FORM of X))
                            (QUOTE DESCENDANTS))
                      (PROGN (SETQ TEM
                               (QUOTE (SUPERATOMPARTITIONS MOLECULES SUPERATOMS 
                                                           RINGS RINGSKELETONS 
                                                           NOFVRINGS DAISIES 
                                                           NUMPARTITIONS 
                                                         BIVALENTPARTITIONS 
                                                           NOLOOPEDRINGS 
                                                           PERMRADS GENMOL)))
                             (OR (MEMB (CAR (fetch FORM of X))
                                       TEM)
                                 (SETQ TEM (CONS (CAR (fetch FORM of X))
                                                 TEM)))
                             TEM)))
                [for X IN TEM BIND NEWFN
                   DO
                    [/MOVD
                      X
                      (SETQ NEWFN
                        (COND
                          ((CAR (SETQ GENSYMLST (CDR GENSYMLST)))
                            (AND
                              (GETD (CAR GENSYMLST))
                              (HELP "ERROR IN EXAMPLE" 
                               "FUNCTION DEFINITIONS MAY HAVE BEEN SMASHED"))
                            (CAR GENSYMLST))
                          (T (GENSYM]
                    (/PUTD X (LIST (QUOTE LAMBDA)
                                   (SETQ TEM (ARGLIST X))
                                   (LIST (QUOTE LIST)
                                         (LIST (QUOTE 1ATRAND)
                                               (CONS NEWFN TEM]
                (/MOVD (QUOTE EXAMPLELABELEDGES)
                       (QUOTE LABELEDGES))
                (/MOVD (QUOTE EXAMPLELABELFV)
                       (QUOTE LABELFV))
                (/MOVD (QUOTE EXAMPLELLABELNODES)
                       (QUOTE LLABELNODES))
                [SETQ X (CONS (QUOTE DONE)
                              (COPY (EXAMPLE X]
                (ERROR!)))
        (COND
          ((EQ (CAR X)
               (QUOTE DONE))
            (CDR X))
          (T (ERROR!]
      ((type? STRUCFORM X)
        (REXAMPLE (CDDR X))
        (SETQ X (GENAPPLY X FIXEDFNLIST T))
        (COND
          ((STRUCLIST? X)
            (1ATRAND (CDR X)))
          (T X)))
      (T (REXAMPLE X])

(SELECT
  [LAMBDA (L N)
    (NLEFT L N])

(SELECTL
  [LAMBDA (OBJ LNUM)
    (PROG (X)
          (AND LNUM (CONS [CAR (SETQ X (SPLIT OBJ (CAR LNUM]
                          (SELECTL (CDR X)
                                   (CDR LNUM])

(SELECTLL
  [LAMBDA (LOBJ LLNUM)
    (AND LOBJ LLNUM (CONS (SELECTL (CAR LOBJ)
                                   (CAR LLNUM))
                          (SELECTLL (CDR LOBJ)
                                    (CDR LLNUM])

(EDGES
  [LAMBDA (STRUC)
    (for CT in (fetch CTABLE of STRUC)
       join (for N in (fetch NBRS of CT)
               when (AND (SMALLP N)
                         (NOT (IGREATERP (fetch NODENUM of CT)
                                         N)))
               rcollect (CONS (fetch NODENUM of CT)
                              N])

(EXAMPLELLABELNODES
  [LAMBDA (STRUC LLABELS)
    (LIST (create LABELING LABELED ←(SELECTLL (LISTBYVALENCE STRUC)
                                              LLABELS)
                  LSTRUC ←(create STRUCTURE reusing STRUC GROUP ← NIL])

(EXAMPLELABELFV
  [LAMBDA (STRUC LABELS)
    (LIST (create LABELING LABELED ←(SELECTL (COLLECTFV STRUC)
                                             LABELS)
                  LSTRUC ←(create STRUCTURE reusing STRUC GROUP ← NIL])

(EXAMPLELABELEDGES
  [LAMBDA (STRUC LABELS)
    (LIST (create LABELING LABELED ←(SELECTL (EDGES STRUC)
                                             LABELS)
                  LSTRUC ←(create STRUCTURE reusing STRUC GROUP ← NIL])

(1ATRAND
  [LAMBDA (L)
    (CAR (NTH L (RAND 1 (LENGTH L])

(SPLIT
  [LAMBDA (L N)

          (* Returns a pair of lists, (l1 . l2) WHERE l1 is a list of 
          elements of L, of length N, and l2 is the REMAINDER)


    (COND
      ((NULL L)
        (LIST NIL))
      ((ZEROP N)
        (CONS NIL L))
      ((EQ N (LENGTH L))
        (LIST L))
      [(NOT (IGREATERP (RAND 1 (LENGTH L))
                       N))
        ([LAMBDA (Z)
            (RPLACA Z (CONS (CAR L)
                            (CAR Z]
          (SPLIT (CDR L)
                 (SUB1 N]
      (T ([LAMBDA (Z)
             (RPLACD Z (CONS (CAR L)
                             (CDR Z]
           (SPLIT (CDR L)
                  N])

(REXAMPLE
  [LAMBDA (X)                                   (* Replaces any STRUCFORMs with 
                                                examples of them)
    (COND
      ((OR (NLISTP X)
           (type? STRUCTURE X)))
      ((type? STRUCFORM X)
        (/RPLNODE2 X (EXAMPLE X)))
      (T (REXAMPLE (CAR X))
         (REXAMPLE (CDR X])
)
  (RPAQ EXAMPLEFIXED)
  [ADDTOVAR USERMACROS (DE NIL (ORR ((E (DRAW (EXAMPLE (##))
                                              T)
                                        T))
                                    ((E (QUOTE (can't draw]
  (ADDTOVAR EDITCOMSA DE)
STOP